(include "lib/data-structures.scm")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; define data structures and their constructors ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-woof-structure woof-object class fields prim-data)
(define new-woof-object
  (lambda (#!key (class #f) (fields (make-table test: string=?)) (prim-data #f))
    (make-woof-object
     class
     fields
     prim-data)))

(define-woof-structure woof-class-object class fields prim-data
  name super slots super-list)
(define new-woof-class-object
  (lambda (#!key (class #f) (fields (make-table test: string=?)) (prim-data #f) (name "")
		 (super #f) (slots '()) (super-list '()))
    (make-woof-class-object
     class
     fields
     prim-data
     name
     super
     slots
     super-list
     )))

(define-woof-structure woof-function-object class fields prim-data
  sig specs block)
(define new-woof-function-object
  (lambda (#!key (class #f) (fields (make-table test: string=?)) (prim-data #f) (sig "")
		 (specs '()) (block #f))
    (make-woof-function-object
     class
     fields
     prim-data
     sig
     specs
     block
     )))

(define-woof-structure woof-block-object class fields prim-data
  code code-pc home)
(define new-woof-block-object
  (lambda (globals #!key (class (class-by-name "Block" globals))
		   (fields (make-table test: string=?)) (prim-data #f) (code '())
		   (code-pc 0) (home (new-block-context env: '())))
    (make-woof-block-object
     class
     fields
     prim-data
     code
     code-pc
     home
     )))

(define new-top-level-block
  (lambda (state code)
    (new-woof-block-object
     (machine-state-globals state)
     code: code
     home: (woof-nil (machine-state-globals state))
     code-pc: 0
     )))


(define-woof-structure block-context 
  pc block stack sender home tmps env exception-handlers)
(define new-block-context
  (lambda (#!key (pc 0) (block #f) (stack '()) (sender #f)
		 (home #f) (tmps '()) (env '()) (exception-handlers '()))
    (make-block-context
     pc
     block
     stack
     sender
     home
     tmps
     env
     exception-handlers
     )))

(define-woof-structure exception-handler 
  error-class handler-block context)
(define new-exception-handler
  (lambda (state #!key
		 (error-class (woof-nil state))
		 (handler-block (woof-nil state))
		 (context (woof-nil state)))
    (make-exception-handler
     error-class
     handler-block
     context)))

(define-woof-structure woof-continuation class fields prim-data
  context)
(define new-woof-continuation
  (lambda (globals #!key (class (class-by-name "Continuation" globals))
		   (fields (make-table test: string=?)) (prim-data #f)
		   (context #f))
    (make-woof-continuation
     class
     fields
     prim-data
     context
     )))

(define-woof-structure woof-globals 
  functions classes misc)
(define new-woof-globals
  (lambda (#!key (functions (make-table test: string=?))
		 (classes (make-table test: string=?))
		 (misc (make-table test: string=?)) )
    (make-woof-globals
     functions
     classes
     misc
     )))

(define-woof-structure return-addr 
  pc fn-code env)
(define new-return-addr
  (lambda (#!key (pc 0) (fn-code '()) (env '()))
    (make-return-addr
     pc
     fn-code
     env)))

(define-woof-structure machine-state
  active-context globals)
(define new-machine-state
  (lambda (#!key (active-context #f) (globals (new-woof-globals)))
    (make-machine-state
     active-context
     globals
     )))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; woof instance creation/access ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define install-global!
  (lambda (obj name globals)
    (table-set! (woof-globals-misc globals)
		name
		obj)))

(define install-class!
  (lambda (class globals)
    (install-global! class (woof-class-object-name class) globals)))

(define install-function!
  (lambda (w-func globals)
    (let* ((sig (woof-function-object-sig w-func))
	   (new-group (append (list w-func)
			      (table-ref
			       (woof-globals-functions globals)
			       sig
			       '()))))
      (table-set! (woof-globals-functions globals) sig new-group))))

(define global-by-name
  (lambda (name globals)
    (table-ref (woof-globals-misc globals) name)))

(define class-by-name
  (lambda (name globals)
    (global-by-name name globals)))

(define create-meta-class-for
  (lambda (class globals)
    (let* ((super (woof-object-class (woof-class-object-super class)))
	   (new-class (new-woof-class-object
		       name: (string-append "Meta" (woof-class-object-name class))
		       super: super
		       super-list: (append (list super)
					   (woof-class-object-super-list super))
		       class: (class-by-name "MetaClass" globals)
		       )))
      (install-class! new-class globals)
      new-class)))


(define create-class
  (lambda (name super globals)
    (let ((new-class (new-woof-class-object name: name
					    super: super
					    super-list: (append (list super)
								(woof-class-object-super-list super))
					    )))
      (woof-object-class-set! new-class (create-meta-class-for new-class globals))
      new-class)))


;; singleton instance of nil
(define woof-nil
  (lambda (globals)
    (global-by-name "nil" globals)))


;; singleton instance of true
(define woof-true
  (lambda (globals)
    (global-by-name "true" globals)))

;; singleton instance of false
(define woof-false
  (lambda (globals)
    (global-by-name "false" globals)))

(define woof-boolean-instance
  (lambda (s-bool globals)
    (if s-bool
	(woof-true globals)
	(woof-false globals)
	)))

(define woof-instance
  (lambda (w-class)
    (new-woof-object class: w-class)))

(define woof-string-instance
  (lambda (text globals)
    (let ((w-string (woof-instance (class-by-name "String" globals))))
      (woof-object-prim-data-set! w-string text)
      w-string)))

(define woof-integer-instance
  (lambda (i globals)
    (let ((w-i (woof-instance (class-by-name "Integer" globals))))
      (woof-object-prim-data-set! w-i i)
      w-i)))

(define woof-list-instance
  (lambda (s-list globals)
    (let ((w-list (woof-instance (class-by-name "List" globals))))
      (woof-object-prim-data-set! w-list s-list)
      w-list)))

(define woof-block-instance
  (lambda (s-lambda globals)
    (let ((w-block (woof-instance (class-by-name "Block" globals))))
      (woof-object-prim-data-set! w-block s-lambda)
      w-block)))

(define woof-exception-instance
  (lambda (msg state)
    (let ((w-excep (woof-instance (class-by-name "Exception" (machine-state-globals state)))))
      (woof-object-field-set!
       w-excep
       "message"
       (woof-string-instance msg (machine-state-globals state))
       (machine-state-globals state))
      w-excep)))

(define woof-function-instance
  (lambda (s-sig s-specs)
    (let ((w-func (new-woof-function-object
		   sig: s-sig
		   specs: s-specs)))
      w-func)))


;; returns woof-nil if field not found
(define read-woof-object-field
  (lambda (object field-name globals)
    (let ((field-hash (woof-object-fields object)))
      (table-ref
       field-hash
       field-name
       (woof-nil globals)))))

;; returns the value that was set
(define woof-object-field-set!
  (lambda (object field-name value globals)
    (let ((field-hash (woof-object-fields object)))
      (table-set! field-hash field-name value)
      value)))

